;;(load "ut.scm")
(define (【*】+【*】 a b) (if (or (eq? a '无穷大)(eq? b '无穷大)) '无穷大 (if (eq? a '无穷小) b (if (eq? b '无穷小) a (+ a b)))))
(def/scm-rest + l)
(define (【*】-【*】 a b) (- a b))
(def/scm-rest - l)
(define (【*】*【*】 a b) (* a b))
(def/scm-rest * l)
(define (【*】/【*】 a b) (/ a b))
(def/scm-rest / l)
(define (【*】==【*】 a b) (cond ((number? a) (= a b))((char? a)(char=? a b))))
(define (【*】>=【*】 a b) (cond ((number? a) (>= a b))((char? a)(char>=? a b))))
(define (【*】<=【*】 a b) (cond ((number? a) (<= a b))((char? a)(char<=? a b))))
(define (【*】>【*】 a b) (cond ((number? a) (> a b))((char? a)(char>? a b))))
(define (【*】<【*】 a b) (cond ((number? a) (< a b))((char? a)(char<? a b))))
(define (【*】==【*】==【*】 a b c) (and (= a b)(= b c)))
(define (【*】==【*】<【*】 a b c) (and (= a b)(< b c)))
(define (【*】==【*】>【*】 a b c) (and (= a b)(> b c)))
(define (【*】==【*】>=【*】 a b c) (and (= a b)(>= b c)))
(define (【*】==【*】<=【*】 a b c) (and (= a b)(<= b c)))
(define (【*】<【*】==【*】 a b c) (and (< a b)(= b c)))
(define (【*】<【*】<【*】 a b c) (and (< a b)(< b c)))
(define (【*】<【*】>【*】 a b c) (and (< a b)(> b c)))
(define (【*】<【*】>=【*】 a b c) (and (< a b)(>= b c)))
(define (【*】<【*】<=【*】 a b c) (and (< a b)(<= b c)))
(define (【*】>【*】==【*】 a b c) (and (> a b)(= b c)))
(define (【*】>【*】<【*】 a b c) (and (> a b)(< b c)))
(define (【*】>【*】>【*】 a b c) (and (> a b)(> b c)))
(define (【*】>【*】>=【*】 a b c) (and (> a b)(>= b c)))
(define (【*】>【*】<=【*】 a b c) (and (> a b)(<= b c)))
(define (【*】>=【*】==【*】 a b c) (and (>= a b)(= b c)))
(define (【*】>=【*】<【*】 a b c) (and (>= a b)(< b c)))
(define (【*】>=【*】>【*】 a b c) (and (>= a b)(> b c)))
(define (【*】>=【*】>=【*】 a b c) (and (>= a b)(>= b c)))
(define (【*】>=【*】<=【*】 a b c) (and (>= a b)(<= b c)))
(define (【*】<=【*】==【*】 a b c) (and (<= a b)(= b c)))
(define (【*】<=【*】<【*】 a b c) (and (<= a b)(< b c)))
(define (【*】<=【*】>【*】 a b c) (and (<= a b)(> b c)))
(define (【*】<=【*】>=【*】 a b c) (and (<= a b)(>= b c)))
(define (【*】<=【*】<=【*】 a b c) (and (<= a b)(<= b c)))
(define (【*】而且【*】 a b) (and a b))
;;(define (【*】而且【*】、\.\.\.  a  . b) (map and a b))
(def/rest 【*】而且【*】 a b)
(define (【*】并且【*】 a b) (and a b))
(def/rest 【*】并且【*】 a b)
(define (【*】同时【*】 a b) (and a b))
(def/rest 【*】同时【*】 a b)
(define (【*】或者【*】 a b) (or a b))
(define (【*】或者【*】\.\.\.  a . b) (let ((s (or a (car b)))) (tr-list (i e b 1) (set! s (or s e))) s))
(define (【*】是【*】 a b) (eq? a b))
(define (【*】不是【*】 a b) (not (eq? a b)))
(define-macro (【*】=【*】 a b)
  (if (atom? a)
     `(set! ,a ,b)
     `(let-set! ,a ,b)))
(define (【*】 a) a)
(define (宏终结语句) #t)
(define (显示【*】【*】\.\.\. fmt . v-l) (display (apply format fmt v-l)))
(define (显示【*】【*】 fmt v-l) (display (format fmt v-l)))
(define (显示【*】 str) (display str))
(define (打印【*】 str) (display str))
(define (显示新行) (newline))
(define-macro (【*】直到【*】 body condi) `(call/cc (lambda (exit-until) (loop ,@body (if ,condi (exit-until))))))
(define (规格化【*】【*】\.\.\. fmt . v-l) (apply format fmt v-l))
(define (规格化【*】【*】 fmt  v-l) (format fmt v-l))
(define (运行列表参数函数【*】【*】\.\.\. 函数名 . 参数列表) (apply 函数名 参数列表))
(define (运行列表参数函数【*】【*】 函数名  参数列表) (apply 函数名 参数列表))
(define 运行列表参数函数 apply)


;;these are system function or macro

(define 空 '())
(define 真 #t)
(define 假 #f)
(define 错误 'err)


;;these are system variable can be used in program

(define-macro (那么 首语句 . 后语句)
  (if (null? 后语句)
      `(begin ,首语句)
      `(begin ,首语句 ,@后语句)))
(define-macro (否则 首语句 . 后语句)
  (if (null? 后语句)
      `(begin ,首语句)
      `(begin ,首语句 ,@后语句)))
      
(define-macro (如果 条件 真语句 . 假语句)
  (if (null? 假语句)
      `(if ,条件 ,真语句)
      `(if ,条件 ,真语句 ,@假语句)))
(define-macro (分类1 . 语句)
  (if (null? 语句)
      #f
      (let ((clause (car 语句)))
	(if (cdr clause)
	    `(if ,(car clause)
		 (begin ,@(cdr clause))
		 (分类1 ,@(cdr 语句)))
	    `(or ,(car clause)
		 (分类1 ,@(cdr 语句)))
	    ))))
(define-syntax 并列语句
  (syntax-rules ()
    ((_ e ...) (begin e ...))))
(define-syntax 执行
  (syntax-rules ()
    ((_ e ...) (begin e ...))))
(define-syntax 分类
  (lambda (x)
    (syntax-case x ()
      [(_ c1 c2 ...)
       (let f ([c1 #'c1] [cmore #'(c2 ...)])
         (if (null? cmore)
             (syntax-case c1 (否则 =>)
               [(否则 e1 e2 ...) #'(begin e1 e2 ...)]
               [(e0) #'(let ([t e0]) (if t t))]
               [(e0 => e1) #'(let ([t e0]) (if t (e1 t)))]
               [(e0 e1 e2 ...) #'(if e0 (begin e1 e2 ...))])
             (with-syntax ([rest (f (car cmore) (cdr cmore))])
               (syntax-case c1 (=>)
                 [(e0) #'(let ([t e0]) (if t t rest))]
                 [(e0 => e1) #'(let ([t e0]) (if t (e1 t) rest))]
                 [(e0 e1 e2 ...)
                  #'(if e0 (begin e1 e2 ...) rest)]))))])))

(define-syntax 循环
  (lambda (x)
    (syntax-case x ()
      [(k e ...)
       (with-syntax ([break (datum->syntax #'k '循环退出)])
         #'(call/cc
             (lambda (break)
               (let f () e ... (f)))))])))
(define-syntax 遍历2
  (syntax-rules (针对每组索引子项 针对每个索引 针对每个子项 针对每个元素)
    ((_ d n 针对每组索引子项 i e e1 ...)
     (cond
      ((and (string? d)(integer? n)) (tr-string (i e d n) e1 ...))
      ((and (list? d)(integer? n)) (tr-list (i e d n) e1 ...))
      ))
    ((_ d 针对每组索引子项 i e e1 ...)
     (cond
      ((string? d) (tr-string (i e d 0) e1 ...))
      ((list? d) (tr-list (i e d 0) e1 ...))
      ))
    ((_ d n 针对每个索引 i e1 ...)
     (cond
      ((and (string? d)(integer? n)) (let ((len (string-length d))) (dotimes (i len)(if (= i 0) (set! i (+ i n))) e1 ...)))
      ((and (list? d)(integer? n)) (let ((len (length d))) (dotimes (i len) (if (= i 0) (set! i (+ i n))) e1 ...)))
      ((and (integer? d)(integer? n)) (dotimes (i d) (if (= i 0) (set! i (+ i n))) e1 ...))
      ))
    ((_ d 针对每个索引 i e1 ...)
     (cond
      ((string? d) (let ((len (string-length d))) (dotimes (i len) e1 ...)))
      ((list? d) (let ((len (length d))) (dotimes (i len) e1 ...)))
      ((integer? d) (dotimes (i d) e1 ...))
      ))
    ((_ d n 针对每个子项 i e1 ...)
     (cond
      ((and (string? d)(integer? n))(dostring-n  (i d n) e1 ...))
      ((and (list? d)(integer? n))(dolist-n (i d n) e1 ...))
      ))
    ((_ d 针对每个子项 i e1 ...)
     (cond
      ((string? d)(dostring (i d) e1 ...))
      ((list? d)(dolist (i l) e1 ...))
      ))
    ((_ d 针对每个元素 i e1 ...)
     (if (list? l)
	 (travel-list d i e1 ...)))
       
    ))
(define-macro (遍历 d-l op-l body)
  (let ((op (nth 0 op-l))
	(v-l (nth-cdr 1 op-l))
	)
    ;;(y-or-n "d-l=~a,op=~a,v-l=~a" d-l op v-l)
  `(travel ,d-l ',op ,v-l ,body)))
(define-syntax 遍历1
  (syntax-rules (针对每组索引子项 针对每个索引 针对每个子项 针对每个元素 执行)
    ((_ d n k (针对每组索引子项 i e) (执行 e1 ...))
     (cond
      ((and (string? d)(integer? n)(integer? k)) (tr-string-step (i e d n k) e1 ...))
      ((and (list? d)(integer? n)(integer? k)) (tr-list-step (i e d n k) e1 ...))
      ))
    ((_ d n (针对每组索引子项 i e) (执行 e1 ...))
     (cond
      ((and (string? d)(integer? n)) (tr-string (i e d n) e1 ...))
      ((and (list? d)(integer? n)) (tr-list (i e d n) e1 ...))
      ))
    ((_ d (针对每组索引子项 i e) (执行 e1 ...))
     (cond
      ((string? d) (tr-string (i e d 0) e1 ...))
      ((list? d) (tr-list (i e d 0) e1 ...))
      ))
    ((_ d n (针对每个索引 i) (执行 e1 ...))
     (cond
      ((and (string? d)(integer? n)) (let ((len (string-length d))) (dotimes (i len)(if (= i 0) (set! i (+ i n))) e1 ...)))
      ((and (list? d)(integer? n)) (let ((len (length d))) (dotimes (i len) (if (= i 0) (set! i (+ i n))) e1 ...)))
      ((and (integer? d)(integer? n)) (dotimes (i d) (if (= i 0) (set! i (+ i n))) e1 ...))
      ))
    ((_ d (针对每个索引 i) (执行 e1 ...))
     (cond
      ((string? d) (let ((len (string-length d))) (dotimes (i len) e1 ...)))
      ((list? d) (let ((len (length d))) (dotimes (i len) e1 ...)))
      ((integer? d) (dotimes (i d) e1 ...))
      ))
    ((_ d n (针对每个子项 i) (执行 e1 ...))
     (cond
      ((and (string? d)(integer? n))(dostring-n  (i d n) e1 ...))
      ((and (list? d)(integer? n))(dolist-n (i d n) e1 ...))
      ))
    ((_ d (针对每个子项 i) (执行 e1 ...))
     (cond
      ((string? d)(dostring (i d) e1 ...))
      ((list? d)(dolist (i l) e1 ...))
      ))
    ((_ d (针对每个元素 i) (执行 e1 ...))
     (if (list? l)
	 (travel-list d i e1 ...)))
       
    ))
    
(define-syntax 注册
  (syntax-rules (cyl文件 scm文件 别名 数据结构 外部符号 输出符号 输出文件路径)
    ((_ cyl文件 fn1 ...)
     (reg-cyl (list fn1 ...)))
    ((_ 别名 sn1 an1 ...)
     (reg-alias (list sn1 an1 ...)))
    ((_ scm文件 fn1 ...)
     (reg-scm (list fn1 ...)))
    ((_ 外部符号 ln1 on1 ...)
     (reg-outsymbol (list ln1 on1 ...)))
    ((_ 输出符号 pn1 ...)
     (reg-extern-symbol (list pn1 ...)))
    ((_ 输出文件路径 p)
     (reg-path p))
    ((_ 数据结构 name field ...)
     (define-structure name field ...))
    ))
(define (reg-extern-symbol l)
  (set! cyl-output-symbol-list l))
(define (reg-path p)
  (set! cyl-output-path p))
(define (reg-cyl l)
  ;;(y-or-n "reg-cyl:l=~a\n" l)
  (dolist (i l)
	  (if (and (list? l)(string? i))
	      (out-symbol-file-input i "scm")))
  )
(define (reg-scm l)
  ;;(y-or-n "reg-cyl:l=~a\n" l)
  (let ((res-l '()))
  (dolist (i l)
	  (if (and (list? l)(string? i))
	      (push (rd-file-string i) res-l)))
  (merge-str-blank (reverse res-l))
  ))

(define (out-symbol-file-input s lang)
  (cond
   ((string=? (substring s 0 2) "./")
    (set! s (string-append (current-directory) (substring s 1 (string-length s)))))
   ((string=? (substring s 0 2) "~/")
    (set! s (string-append cyl-home-directory (substring s 1 (string-length s)))))
   )
    
  (let ((p (open-input-file s)))
    (let* ((ser-no (read p))
	   (cyl-l (read p))
	   (local-l (read p))
	   (out-l (read p))
	   (fn (substring s 0 (- (string-length s) 4)))
	   (lang-fn (format "~a.~a" fn lang))
	   (fn-sym (string->symbol fn))
	   )
      (dolist (e out-l)
	      (set-car! (nth 2 e) fn-sym)
	     
	      (push e cyl-extern-symbol-dict-list)
	      )
      (append-load-file s lang-fn))))
(define (reg-alias l)
  (if (= (mod (length l) 2) 0)
      (if (and (pair? l)(string? (nth 0 l)))
	  (let ((a (nth 0 l))
		(b (nth 1 l))
		(c '())
		)
	    (set! c (find-current-coding-list b))
	    (if c
		(begin
		  (if (eq? cyl-define-status 'top-level)
		      (append-new-coding-atexp a '全局别名 0 '别名 (nth 2 c))
		      (append-new-coding-atexp a '局部别名 0 '别名 (nth 2 c)))
		  (set! l (cddr l))
		  (reg-alias l)
		  )
		(list 'err cyl-loc 'reg-alias (format "别名注册中，后边符号必须被定义。[~a]" b)))
	    )
	  )
      (list 'err cyl-loc 'reg-alias (format "别名注册需要双数[~a]" (length l)))))
(define (reg-outsymbol l)
   (if (= (mod (length l) 2) 0)
      (if (and (pair? l)(string? (nth 0 l)))
	  (let ((a (nth 0 l))
		(b (nth 1 l))
		(c '())
		(sym "")
		(fn "")
		(path "")
		)
	    (cond
	     ((string=? (substring b 0 2) "./")
	      (set! b (string-append (current-directory) (substring b 1 (string-length s)))))
	     ((string=? (substring b 0 2) "~/")
	      (set! b (string-append cyl-home-directory (substring b 1 (string-length s)))))
	     )
	    (let-set! (sym fn path) (reverse-get-outsymbol-string b (- (length b) 1) #\: #\/))
	    (if (not sym) (set! sym a))
	    (if (string=? a sym)
		(set! c (get-extern-symbol-definition (string-append path fn) sym #f))
		(set! c (get-extern-symbol-definition (string-append path fn) sym path))
		)
	    (if (and (list? c)(not (eq? (nth 0 c) 'err)))
		(if (string=? a sym)
		    (if (eq? cyl-define-status 'top-level)
			(push c cyl-current-symbol-dict-list)
			(push c cyl-local-symbol-dict-list))
		    (if (eq? cyl-define-status 'top-level)
			(append-new-coding-atexp a '全局别名 0 '别名 c)
			(append-new-coding-atexp a '局部别名 0 '别名 c))
		    )
		(if (eq? (nth 0 c) 'err)
		    c
		    (begin
		      (set! l (cddr l))
		      (reg-outsymbol l)
		      )
		    )
		))
	  )
      (list 'err cyl-loc 'reg-alias (format "外部符号注册需要双数[~a]" (length l)))))
(define (reverse-get-outsymbol-string s n ch1 ch2)
  (let* ((len (string-length s))
	(sym #f)
	(sym-i len)
	(fn #f)
	(fn-i len)
	(path #f)
	(path-i len)
	(n (- len 1))
	)
    (call/cc (lambda (break-reverse-get-string)
    (tr-string-step (i c s n -1)
		    (if (char=? c ch1)
			(begin
			  (set! sym-i i)
			  (set! sym (substring s (+ i 1) (string-length s)))
			  )
			(if (char=? c ch2)
			    (begin
			      (set! fn (substring s (+ i 1) sym-i))
			      (set! path (substring s 0 (+ i 1)))
			      (break-reverse-get-string (list sym fn path))
			      ))))
    (set! fn (substring s 0 sym-i))
    (list sym fn "")))))
(define (get-extern-symbol-definition s sym path)
  (let ((p (open-input-file s))
	(lang "scm")
	)
    (let* ((ser-no (read p))
	   (cyl-l (read p))
	   (local-l (read p))
	   (out-l (read p))
	   (fn (substring s 0 (- (string-length s) 4)))
	   (lang-fn (format "~a.~a" fn lang))
	   (fn-sym (string->symbol fn))
	   )
      (if (string? path)
	  (cond
	   ((and (> (string-length path) 7)(or (string=? (substring path 0 7) "https:/")(string=? (substring path 0 7) "http://")))
   	    (set! lang-fn (format "~a.全域引用.~a" fn lang)))
	   ((and (> (string-length path) 1)(char=? (string-ref path 0) #\/))
	    (set! lang-fn (format "~a.外部引用.~a" fn lang)))
	   
	   ))
     
      (dolist (e out-l)
	      
	      (set-car! (nth 2 e) fn-sym)
	     
	      ;;到底是全部导入还是单个导入？单个导入可以减少符号碰撞。但是如何解决符号的相互引用呢？
	      (push e cyl-extern-symbol-dict-list)
		
	      )
      ;;到底是全域符号还是本地符号？使用全域符号可以解决符号碰撞，但是对于无碰撞符号如何处理？
      (append-load-file s lang-fn) 
      ))
  )
(define (append-load-file s lang-fn)
  (if (not (member s cyl-load-file-list))
      (begin
	(push s cyl-load-file-list)
	(load lang-fn))))
  
			    
  
		  
	  
       

		 
      

